home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / fd200.zip / FD_UTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-27  |  5KB  |  176 lines
  1. { ***********   COMPARISON AND PRINTING ROUTINES FOR FD Lists ********** }
  2.  
  3. { NOTE  -- 86 rules defined CW, ASCII, RTTY & AMTOR to be 'cw' modes
  4.                             AM, FM, SSB to be 'phone' modes
  5.                        and  PACKET a unique mode
  6.        the check_mode function complies with that requirement -- may
  7.        have to be changed if rules change
  8.        It should return  0 if mode 1 = mode 2
  9.                         -1 if mode 1 < mode 2
  10.                          1 if mode 1 > mode 2
  11. }
  12.  
  13. procedure add_to_score;
  14. begin
  15.   total_contacts := total_contacts + 1;
  16.   contacts[ord(pdata.band)] := contacts[ord(pdata.band)] + 1;
  17.   case pdata.xmtmode of
  18.     SSB, AM, FM : score := score + my_mult;
  19.     CW, RTTY, AMTOR, PACKET : score := score + my_mult*2;
  20.   end;
  21. end;
  22.  
  23. procedure sub_fm_score(pdata : data);
  24. begin
  25.   total_contacts := total_contacts - 1;
  26.   contacts[ord(pdata.band)] := contacts[ord(pdata.band)] - 1;
  27.   case pdata.xmtmode of
  28.     SSB, AM, FM : score := score - my_mult;
  29.     CW, RTTY, AMTOR, PACKET : score := score - my_mult*2;
  30.   end;
  31. end;
  32.  
  33. function check_if_ok;
  34. var chk_key : char;
  35.     key_ok  : boolean;
  36. begin
  37.   gotoxy(12,16); ClrEol;
  38.   Brite_color;
  39.   with d1 do
  40.     writeln(callsign:6,
  41.             class:5,
  42.             pmodstr(xmtmode):7,
  43.             bandstr(band):4,
  44.             section: 15,
  45.             date:9,time:6);
  46.   normcolor;
  47.   gotoxy(30,18);
  48.   write('<D>elete, <N>ext, <Esc>ape ...');
  49.   key_ok := FALSE;
  50.   repeat
  51.     chk_key := readkey;
  52.     case chk_key of
  53.       'd','D' : begin
  54.                   check_if_ok := 1;
  55.                   sub_fm_score(d1);
  56.                   key_ok := TRUE;
  57.                 end;
  58.       'n','N' : begin
  59.                   check_if_ok := 0;
  60.                   key_ok := TRUE;
  61.                 end;
  62.       #27     : begin
  63.                   check_if_ok := -1;
  64.                   escape := TRUE;
  65.                   key_ok := TRUE;
  66.                 end;
  67.       #0      : chk_key := readkey;
  68.     end;
  69.   until key_ok;
  70.   gotoxy(1,16); ClrEol;
  71.   gotoxy(1,18); ClrEol;
  72. end;
  73.  
  74. var  del_ptr : LINK;
  75.  
  76. procedure delete_entry;
  77. label esc_out;
  78. var it_was : boolean;
  79.     tstmode : mode;
  80.     tstband : hamband;
  81.  
  82.   procedure d_entry(m : mode);
  83.   begin
  84.     del_ptr^.leaf.xmtmode := m;
  85.     if (find(root,del_ptr) <> NIL)
  86.       then it_was := delete(root,del_ptr);
  87.   end;
  88.  
  89. begin
  90.   del_ptr^.leaf.callsign := '';
  91.   escape := FALSE;
  92.   gotoxy(30,16);
  93.   write('Enter callsign : ');
  94.   readln(del_ptr^.leaf.callsign);
  95.   UpperCase(del_ptr^.leaf.callsign);
  96.   while length(del_ptr^.leaf.callsign) < 6 do
  97.     del_ptr^.leaf.callsign := ' ' + del_ptr^.leaf.callsign;
  98.   for tstband := B440 downto B160 do
  99.     begin
  100.       del_ptr^.leaf.band := tstband;
  101.       d_entry(CW); if escape = TRUE then goto esc_out;
  102.       d_entry(SSB); if escape = TRUE then goto esc_out;
  103.       d_entry(PACKET); if escape = TRUE then goto esc_out;
  104.     end;
  105. esc_out:
  106. end;
  107.  
  108. { ***********   --------------------------------------------- ********** }
  109.  
  110. procedure utility;
  111. var ukey : char;
  112. begin
  113.   save_screen;
  114.   clrscr;
  115.   window(20,9,65,24);
  116.   gotoxy(1,1);
  117.   writeln('UTILITIES: <L>oad data file ');
  118.   writeln('           <S>ave data file ');
  119.   writeln('           <D>elete entry');
  120.   writeln('           <P>rint log');
  121.   writeln('           <I>nit Parameters');
  122.   writeln('           <E>xit program');
  123.   write  ('           <ESC>ape ......');
  124.   window(1,1,80,24);
  125.   repeat ukey := readkey
  126.   until  ukey in ['d','D','e','E','i','I','p','P','l','L','s','S',#27];
  127.   case ukey of
  128.     'e','E': begin
  129.                clrscr;
  130.                write('Exit to DOS .. <Y/N> ..');
  131.                repeat ukey := readkey
  132.                until ukey in ['n','N','y','Y'];
  133.                case ukey of
  134.                  'y','Y' : begin
  135.                              restore_entry_screen;
  136.                              halt;
  137.                            end;
  138.                end;
  139.              end;
  140.     'i','I': setup;
  141.     'l','L': begin
  142.                clrscr;
  143.                read_file;
  144.              end;
  145.     'd','D': delete_entry;
  146.     'p','P': begin
  147.                window(1,1,80,24);
  148.                clrscr;
  149.                line_nbr := 0;
  150.                tprint(root);
  151.                if (escape = FALSE) then
  152.                begin
  153.                  gotoxy(30,24);
  154.                  write('Press <Retrn> to continue ..');
  155.                  repeat ukey := readkey until ukey = #13;
  156.                end;
  157.                escape := FALSE;
  158.              end;
  159.     's','S': write_file(root);
  160.     #27    : ukey := ' ';
  161.   end;
  162.   restore_screen;
  163.   window(1,1,80,25);
  164.   hide_cursor;
  165. end;
  166.  
  167. procedure out_of_memory;
  168. begin
  169.   sound(440);
  170.   delay(1000);
  171.   sound(360);
  172.   delay(1000);
  173.   nosound;
  174. end;
  175.  
  176.